home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6-1 / Night Owl's Shareware - PDSI-006-1 - Night Owl Corp (1992).iso / 033a / mfm_109b.arj / COPYMOVE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-20  |  17KB  |  465 lines
  1. {========================================================================}
  2. Procedure CenterWrite(Row : Byte; CenteredString : String);
  3.   Begin
  4.     AnsiGotoXY(Row,1); AnsiClearToEOL;
  5.     AnsiGotoXY(Row,40-(Length(CenteredString) Div 2));
  6.     Write(CenteredString);
  7.   End;
  8. {========================================================================}
  9. Function FileCopy(FromFileName, ToFileName : String; CopyOrMove : Char) : Boolean;
  10.   Var
  11.     FromFile, ToFile : File;
  12.     OverWrite : Boolean;
  13.     Fcc : Char;
  14.     TempEntry : ListPtr;
  15.     ToFilesBbs : Text;
  16.   Begin
  17.     FileCopy := False; OverWrite := True;
  18.     FindFirst(FromFileName,AnyFile,DirInfo);
  19.     If DosError = 0 Then
  20.     Begin
  21.       FindFirst(ToFileName,AnyFile,DirInfo);
  22.       If DosError = 0 Then
  23.       Begin
  24.         OverWrite := False;
  25.         AnsiClearScreen; AnsiGotoXY(21,1);
  26.         NewTextColor(Black); NewTextBackground(Cyan);
  27.         Write(Pgmid+'      ^Q=quit ?=help');
  28.         NewTextColor(White); NewTextBackground(Black);
  29.         NextPrintEntry := CurrentEntry; DisplayRecord(22);
  30.         NewTextColor(White);
  31.         CenterWrite(23,'already exists as');
  32.         New(TempEntry);
  33.         TempEntry^.TypeOfRecord := FileRecord;
  34.         TempEntry^.FileName := DirInfo.Name;
  35.         TempEntry^.FileDate := DirInfo.Time;
  36.         TempEntry^.FileSize := DirInfo.Size;
  37.         Fsplit(ToFileName,D,N,E);
  38.         Assign(ToFilesBbs,D+'FILES.BBS');
  39.         {$I-} Reset(ToFilesBbs); {$I+}
  40.         If IOresult = 0 Then
  41.         Begin
  42.           While (Not Eof(ToFilesBbs)) Do
  43.           Begin
  44.             ReadLn(ToFilesBbs,WorkString);
  45.             If Pos(N+E,WorkString) > 0 Then
  46.             Begin
  47.               TempEntry^.Description := Copy(WorkString,Pos(' ',WorkString)+1,Length(WorkString)-Pos(' ',WorkString));
  48.             End;
  49.           End;
  50.           Close(ToFilesBbs);
  51.         End
  52.         Else
  53.         Begin
  54.           TempEntry^.Description := '';
  55.         End;
  56.         TempEntry^.Tagged := False;
  57.         NextPrintEntry := TempEntry; DisplayRecord(24);
  58.         Dispose(TempEntry);
  59.         NewTextColor(White);
  60.         CenterWrite(25,'Overwrite? (Y/N) ');
  61.         Repeat
  62.           Gbx := GetInput;
  63.           Fcc := Upcase(Chr(Gbx));
  64.         Until Fcc In ['N','Y'];
  65.         Write(Fcc);
  66.         If Fcc = 'Y' Then OverWrite := True;
  67.       End;
  68.       If OverWrite Then
  69.       Begin
  70.         If (CopyOrMove = 'M') And (Copy(FromFileName,1,1) = Copy(ToFileName,1,1)) Then
  71.         Begin
  72.           CenterWrite(22,'Moving');
  73.           CenterWrite(23,FromFileName);
  74.           CenterWrite(24,'to');
  75.           CenterWrite(25,ToFileName);
  76.           FindFirst(ToFileName,AnyFile,DirInfo);
  77.           If DosError = 0 Then
  78.           Begin
  79.             Assign(ToFile,ToFileName);
  80.             Erase(ToFile);
  81.           End;
  82.           Assign(FromFile,FromFileName);
  83.           Rename(FromFile,ToFileName);
  84.         End
  85.         Else
  86.         Begin
  87.           If CopyOrMove = 'C' Then CenterWrite(22,'Copying ') Else CenterWrite(22,'Moving ');
  88.           CenterWrite(23,FromFileName);
  89.           CenterWrite(24,'to');
  90.           CenterWrite(25,ToFileName);
  91.           DoFileCopy(FromFileName,ToFileName);
  92.           Assign(FromFile,FromFileName);
  93.           If CopyOrMove = 'M' Then Erase(FromFile);
  94.         End;
  95.         FileCopy := True;
  96.       End;
  97.     End;
  98.   End;
  99. {========================================================================}
  100. Procedure ShowSizeSpace(Drive : Char; Row : Byte);
  101.   Begin
  102.     Drive := UpCase(Drive);
  103.     AnsiGotoXY(Row,1);
  104.     NewTextColor(Black);
  105.     NewTextBackground(Cyan);
  106.     AnsiClearToEol;
  107.     Write(CurrentEntry^.FileName+' is ',CurrentEntry^.FileSize Div 1024,'K bytes in size!   There are ');
  108.     Write(DiskFree(Ord(Drive)-64) Div 1024);
  109.     Write('K bytes free on drive '+Drive+'.');
  110.     NewTextColor(White); NewTextBackground(Black);
  111.   End;
  112. {========================================================================}
  113. Procedure CopyFile;
  114.   Var
  115.     ToAreaPath : String[80];
  116.     Cfc : Char;
  117.   Begin
  118.     If CurrentEntry^.TypeOfRecord = FileRecord Then
  119.     Begin
  120.       SetupScreen;
  121.       AnsiGotoXY(25,1); AnsiClearToEOL;
  122.       Write(FileAreaPath+CurrentEntry^.FileName);
  123.       ToAreaPath := ChooseArea;
  124.       If ToAreaPath <> 'QUIT' Then
  125.       Begin
  126.         ShowSizeSpace(ToAreaPath[1],24);
  127.         If CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64)-(SizeOfFilesBbs(ToAreaPath)+2048)) Then
  128.         Begin
  129.           ShowSizeSpace(ToAreaPath[1],21);
  130.           CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
  131.           CenterWrite(23,'to');
  132.           CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
  133.           CenterWrite(25,'Proceed with COPY? (Y/N) ');
  134.           Repeat
  135.             Gbx := GetInput;
  136.             Cfc := Upcase(Chr(Gbx));
  137.           Until Cfc In ['N','Y'];
  138.           Write(Cfc);
  139.           If Cfc = 'Y' Then
  140.           Begin
  141.             If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'C') Then
  142.             Begin
  143.               FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
  144.               If DosError = 0 Then
  145.               Begin
  146.                 Changed := False;
  147.                 Assign(FileList,ToAreaPath+'FILES.BBS');
  148.                 Reset(FileList);
  149.                 Assign(NewFileList,ToAreaPath+'FILES.NEW');
  150.                 Rewrite(NewFileList);
  151.                 While (Not Eof(FileList)) Do
  152.                 Begin
  153.                   ReadLn(FileList,WorkString);
  154.                   If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
  155.                   Begin
  156.                     WriteLn(NewFileList,WorkString);
  157.                   End
  158.                   Else
  159.                   Begin
  160.                     WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  161.                     Changed := True;
  162.                   End;
  163.                 End;
  164.                 If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  165.                 Close(FileList); Close(NewFileList);
  166.                 Erase(FileList); Rename(NewFileList,ToAreaPath+'FILES.BBS');
  167.               End
  168.               Else
  169.               Begin
  170.                 Assign(FileList,ToAreaPath+'FILES.BBS');
  171.                 ReWrite(FileList);
  172.                 WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  173.                 Close(FileList);
  174.               End;
  175.             End;
  176.           End;
  177.           ReDrawScreen;
  178.         End
  179.         Else
  180.         Begin
  181.           ReDrawScreen;
  182.           AnsiGotoXY(25,1); AnsiClearToEOL;
  183.           Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
  184.         End;
  185.       End
  186.       Else ReDrawScreen;
  187.     End;
  188.   End;
  189. {========================================================================}
  190. Procedure MoveFile;
  191.   Var
  192.     ToAreaPath : String[80];
  193.     Mfc : Char;
  194.     FileToErase : File;
  195.   Begin
  196.     If CurrentEntry^.TypeOfRecord = FileRecord Then
  197.     Begin
  198.       SetupScreen;
  199.       AnsiGotoXY(25,1); AnsiClearToEOL;
  200.       Write(FileAreaPath+CurrentEntry^.FileName);
  201.       ToAreaPath := ChooseArea;
  202.       If ToAreaPath <> 'QUIT' Then
  203.       Begin
  204.         ShowSizeSpace(ToAreaPath[1],24);
  205.         If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  206.           Or (FileAreaPath[1] = ToAreaPath[1]) Then
  207.         Begin
  208.           ShowSizeSpace(ToAreaPath[1],21);
  209.           CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
  210.           CenterWrite(23,'to');
  211.           CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
  212.           CenterWrite(25,'Proceed with MOVE? (Y/N) ');
  213.           Repeat
  214.             Gbx := GetInput;
  215.             Mfc := Upcase(Chr(Gbx));
  216.           Until Mfc In ['N','Y'];
  217.           Write(Mfc);
  218.           If Mfc = 'Y' Then
  219.           Begin
  220.             If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'M') Then
  221.             Begin
  222.               FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
  223.               If DosError = 0 Then
  224.               Begin
  225.                 Changed := False;
  226.                 Assign(FileList,ToAreaPath+'FILES.BBS');
  227.                 Reset(FileList);
  228.                 Assign(NewFileList,ToAreaPath+'FILES.NEW');
  229.                 Rewrite(NewFileList);
  230.                 While (Not Eof(FileList)) Do
  231.                 Begin
  232.                   ReadLn(FileList,WorkString);
  233.                   If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
  234.                   Begin
  235.                     WriteLn(NewFileList,WorkString);
  236.                   End
  237.                   Else
  238.                   Begin
  239.                     WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  240.                     Changed := True;
  241.                   End;
  242.                 End;
  243.                 If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  244.                 Close(FileList); Close(NewFileList);
  245.                 Erase(FileList); Rename(NewFileList,ToAreaPath+'FILES.BBS');            End
  246.               Else
  247.               Begin
  248.                 Assign(FileList,ToAreaPath+'FILES.BBS');
  249.                 ReWrite(FileList);
  250.                 WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  251.                 Close(FileList);
  252.               End;
  253.               PushRecord(KillEntry);
  254.               OldEntry := KillEntry;
  255.               If KillEntry^.PrevEntry = KillEntry Then
  256.               Begin
  257.                 Dispose(KillEntry);
  258.                 KillEntry := NIL;
  259.               End
  260.               Else
  261.               Begin
  262.                 KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
  263.                 KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
  264.                 KillEntry := KillEntry^.NextEntry;
  265.               End;
  266.               If KillEntry <> NIL Then Dispose(OldEntry);
  267.             End;
  268.           End;
  269.           ReDrawScreen;
  270.         End
  271.         Else
  272.         Begin
  273.           ReDrawScreen;
  274.           AnsiGotoXY(25,1); AnsiClearToEOL;
  275.           Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
  276.         End;
  277.       End
  278.       Else ReDrawScreen;
  279.     End;
  280.   End;
  281. {========================================================================}
  282. Procedure MassMove;
  283.   Var
  284.     ToAreaPath : String[80];
  285.     TempEntry : ListPtr;
  286.     Mmc : Char;
  287.     MoveOk : Boolean;
  288.   Begin
  289.     SetupScreen;
  290.     CenterWrite(25,'Select area to MASS MOVE to...');
  291.     ToAreaPath := ChooseArea;
  292.     If ToAreaPath <> 'QUIT' Then
  293.     Begin
  294.       CenterWrite(25,'Proceed with MASS MOVE? (Y/N) ');
  295.       Repeat
  296.         Gbx := GetInput;
  297.         Mmc := Upcase(Chr(Gbx));
  298.       Until Mmc In ['N','Y'];
  299.       Write(Mmc);
  300.       If Mmc = 'Y' Then
  301.       Begin
  302.         TempEntry := CurrentEntry;
  303.         CurrentEntry := FirstEntry;
  304.         While CurrentEntry^.NextEntry <> NIL Do
  305.         Begin
  306.           MoveOk := False;
  307.           If CurrentEntry^.Tagged Then
  308.           Begin
  309.             ShowSizeSpace(ToAreaPath[1],24);
  310.             If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  311.               Or (FileAreaPath[1] = ToAreaPath[1]) Then
  312.             Begin
  313.               ShowSizeSpace(ToAreaPath[1],21);
  314.               If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'M') Then
  315.               Begin
  316.                 FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
  317.                 If DosError = 0 Then
  318.                 Begin
  319.                   Changed := False;
  320.                   Assign(FileList,ToAreaPath+'FILES.BBS');
  321.                   Reset(FileList);
  322.                   Assign(NewFileList,ToAreaPath+'FILES.NEW');
  323.                   Rewrite(NewFileList);
  324.                   While (Not Eof(FileList)) Do
  325.                   Begin
  326.                     ReadLn(FileList,WorkString);
  327.                     If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
  328.                     Begin
  329.                       WriteLn(NewFileList,WorkString);
  330.                     End
  331.                     Else
  332.                     Begin
  333.                       WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  334.                       Changed := True;
  335.                     End;
  336.                   End;
  337.                   If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  338.                   Close(FileList); Close(NewFileList);
  339.                   Erase(FileList); Rename(NewFileList,ToAreaPath+'FILES.BBS');
  340.                 End
  341.                 Else
  342.                 Begin
  343.                   Assign(FileList,ToAreaPath+'FILES.BBS');
  344.                   ReWrite(FileList);
  345.                   WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  346.                   Close(FileList);
  347.                 End;
  348.                 MoveOk := True;
  349.                 PushRecord(KillEntry);
  350.                 OldEntry := KillEntry;
  351.                 If KillEntry^.PrevEntry = KillEntry Then
  352.                 Begin
  353.                   Dispose(KillEntry);
  354.                   KillEntry := NIL;
  355.                 End
  356.                 Else
  357.                 Begin
  358.                   KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
  359.                   KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
  360.                   KillEntry := KillEntry^.NextEntry;
  361.                 End;
  362.                 If KillEntry <> NIL Then Dispose(OldEntry);
  363.               End;
  364.             End
  365.             Else
  366.             Begin
  367.               ReDrawScreen;
  368.               AnsiGotoXY(25,1); AnsiClearToEOL;
  369.               Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
  370.             End;
  371.           End;
  372.           If (Not MoveOk) Then CurrentEntry := CurrentEntry^.NextEntry;
  373.         End;
  374.       End;
  375.     End;
  376.     CurrentEntry := TopEntry; Row := 1;
  377.     SetupScreen; DisplayScreen;
  378.   End;
  379. {========================================================================}
  380. Procedure MassCopy;
  381.   Var
  382.     ToAreaPath : String[80];
  383.     TempEntry : ListPtr;
  384.     Mcc : Char;
  385.     CopyOk : Boolean;
  386.   Begin
  387.     SetupScreen;
  388.     CenterWrite(25,'Select area to MASS COPY to...');
  389.     ToAreaPath := ChooseArea;
  390.     If ToAreaPath <> 'QUIT' Then
  391.     Begin
  392.       CenterWrite(25,'Proceed with MASS COPY? (Y/N) ');
  393.       Repeat
  394.         Gbx := GetInput;
  395.         Mcc := Upcase(Chr(Gbx));
  396.       Until Mcc In ['N','Y'];
  397.       Write(Mcc);
  398.       If Mcc = 'Y' Then
  399.       Begin
  400.         TempEntry := CurrentEntry;
  401.         CurrentEntry := FirstEntry;
  402.         While CurrentEntry^.NextEntry <> NIL Do
  403.         Begin
  404.           CopyOk := False;
  405.           If CurrentEntry^.Tagged Then
  406.           Begin
  407.             ShowSizeSpace(ToAreaPath[1],24);
  408.             If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  409.               Or (FileAreaPath[1] = ToAreaPath[1]) Then
  410.             Begin
  411.               ShowSizeSpace(ToAreaPath[1],21);
  412.               If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'C') Then
  413.               Begin
  414.                 FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
  415.                 If DosError = 0 Then
  416.                 Begin
  417.                   Changed := False;
  418.                   Assign(FileList,ToAreaPath+'FILES.BBS');
  419.                   Reset(FileList);
  420.                   Assign(NewFileList,ToAreaPath+'FILES.NEW');
  421.                   Rewrite(NewFileList);
  422.                   While (Not Eof(FileList)) Do
  423.                   Begin
  424.                     ReadLn(FileList,WorkString);
  425.                     If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
  426.                     Begin
  427.                       WriteLn(NewFileList,WorkString);
  428.                     End
  429.                     Else
  430.                     Begin
  431.                       WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  432.                       Changed := True;
  433.                     End;
  434.                   End;
  435.                   If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  436.                   Close(FileList); Close(NewFileList);
  437.                   Erase(FileList); Rename(NewFileList,ToAreaPath+'FILES.BBS');
  438.                 End
  439.                 Else
  440.                 Begin
  441.                   Assign(FileList,ToAreaPath+'FILES.BBS');
  442.                   ReWrite(FileList);
  443.                   WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  444.                   Close(FileList);
  445.                 End;
  446.                 CopyOk := True;
  447.               End;
  448.             End
  449.             Else
  450.             Begin
  451.               ReDrawScreen;
  452.               AnsiGotoXY(25,1); AnsiClearToEOL;
  453.               Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
  454.             End;
  455.           End;
  456.           CurrentEntry^.Tagged := False;
  457.           If (Not CopyOk) Then CurrentEntry := CurrentEntry^.NextEntry;
  458.         End;
  459.       End;
  460.     End;
  461.     CurrentEntry := TopEntry; Row := 1;
  462.     SetupScreen; DisplayScreen;
  463.   End;
  464. {========================================================================}
  465.